Monster Media 1996 #14/Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO/prog_gen/instal11.zip/LECTURE.PAS

Pascal/Delphi Source File | 1996-01-11 | 17KB | 638 lines

(**********************************)
(* Lecture du fichier INSTALL.INS *)
(**********************************)
unit Lecture;

interface

uses Dialogs;

const Title_Parag : array [1 .. 8] of string =
                    ('INFORMATION', (* Info about program to install       *)
                     'DISKS',       (* Number of disk                      *)
                     'ORIGIN',      (* Origin informations                 *)
                     'DESTINATION', (* Destination informations            *)
                     'GROUP',       (* Groups to create                    *)
                     'ICONS',       (* Icons to create                     *)
                     'FILES',       (* Files to copy                       *)
                     'RUN');        (* Files to run                        *)
      Number_Para = 8;              (* number of <> paragrafs              *)
      lgn_Remarks = ';';            (* ligne en remarque                   *)
      lgn_Paragrf = '[';            (* marque de paragraphe                *)
      lgn_EqualSi = '=';            (* marque de debut des parametres      *)
      lgn_Separat = ',';            (* marque de separateur des parametres *)
      lgn_Pat_Red = '%';            (* marque d'indicateur de repertoire   *)
      lgn_Pat_Trg = '1';            (* repertoire de destination           *)
      lgn_Pat_Win = 'W';            (* repertoire de Windows               *)
      lgn_Pat_Sys = 'S';            (* repertoire de Windows/System        *)
      lgn_Pat_Rot = 'R';            (* repertoire racine                   *)

(* lecture du fichier d'install *)
function ReadInsFile : integer;
         {00 : File readed OK
          01 : InsFile not found
          02 : Unabled to open InsFile
          03 : Unabled to read one line
          04 : Wrong paragraf title
          05 : Wrong line because = sign not found
          06 : Wrong line because paragrf not found
          07 : Wrong line in a information paragraf
          08 : Wrong line in a disks paragraf
          09 : Wrong line in a origin paragraf
          10 : Wrong line in a destination paragraf
          11 : Wrong line in a group paragraf
          12 : Wrong line in a icons paragraf
          13 : Wrong line in a files paragraf
          14 : Wrong line in a run paragraf
          15 : Wrong number in Num parameter
          16 : Wrong number before = sign
          17 : Wrong parameters in a Group line
          18 : Wrong parameters in a Icons line
          19 : Wrong parameters in a Files line
          20 : Wrong parameters in a Run line
          21 : Wrong number in a Dsk line}

function ReadUnsFile : integer;
         { 0 : OK Uninstall readed correctly
           1 : File doesn't exist
           2 : Unable to read one line
           3 : Error on number in line
           4 : Maximum of file reach
           5 : Wrong number in line}

implementation

uses SysUtils,Decla,Disque;

(*********************************)
(* mise en majuscule de la ligne *)
(*********************************)
function MajusculeLigne (Ligne : string) : string;
var bcl : integer;
    tmp : string;
begin
 tmp := '';
 for bcl := 1 to length (Ligne) do
  Tmp := Tmp + upcase (Ligne [bcl]);
 MajusculeLigne := Tmp;
end;

(*******************************)
(* traitements des lignes lues *)
(*******************************)

(* analyse du nombre de disque *)
function Traitement_NombreDsk (Ligne : string) : boolean;
var Tmp : boolean;
    Err : integer;
begin
 Tmp := true;
 val (Ligne,Disk_Number,Err);
 Tmp := (Disk_Number > 0) and (Err = 0);
 Traitement_NombreDsk := Tmp;
end;

(* analyse du disque *)
function Traitement_Disque (Ligne : string;Numero : integer) : boolean;
begin
 with VPath [Numero] do
  LettDriv := Ligne [1];
 Traitement_Disque := true;
end;

(* analyse du chemin *)
function Traitement_Chemin (Ligne : string;Numero : integer) : boolean;
begin
 with VPath [Numero] do
  PathDriv := Ligne;
 Traitement_Chemin := true;
end;

(* prendre les parametres *)
function Coupe (var Ligne : string) : string;
var Tmp : string;
begin
 Tmp := '';
 Tmp := copy (Ligne,1,pos (lgn_Separat,Ligne) - 1);
 Delete (Ligne,1,pos (lgn_Separat,Ligne));
 Coupe := Tmp;
end;

(* analyse d'une ligne de groupe *)
function Traitement_Groupe (Ligne : string;Numero : integer) : boolean;
var Tmp : boolean;
    Lg1 : string;
    Lg2 : string;
begin
 Tmp := true;
 Delete (Ligne,1,pos (lgn_EqualSi,Ligne));
 Lg1 := Coupe (Ligne);
 Lg2 := Ligne;
 if Numero > Max_Group then
  Tmp := false
 else
 begin
  if not ((Lg1 = '') or (Lg2 = '')) then
  begin
   With VGroup [Numero] do
   begin
    GroupName := Lg1;
    GroupFile := MajusculeLigne (WinDir) + '\' + MajusculeLigne (Lg2);
   end;
  end
  else
   Tmp := False;
 end;
 Traitement_Groupe := Tmp;
end;

(* analyse d'une ligne d'icone *)
function Traitement_Icone (Ligne : string;Numero : integer) : boolean;
var Tmp : boolean;
    Lg1 : string;
    Lg2 : string;
    Lg3 : string;
    lg4 : string;
    Num : integer;
    Err : integer;
begin
 Tmp := true;
 Delete (Ligne,1,pos (lgn_EqualSi,Ligne));
 Lg1 := Coupe (Ligne);
 Lg2 := Coupe (Ligne);
 Lg3 := Coupe (Ligne);
 Lg4 := Ligne;
 Val (Lg1,Num,Err);
 if not ((Lg1 = '') or (Lg2 = '') or
         (Lg3 = '') or (Lg4 = '')) then
 begin
  With VIcons [Numero] do
  begin
   DiskNumb := Num;
   FileName := MajusculeLigne (Lg2);
   if Lg3 [1] = lgn_Pat_Red then
   begin
    case Lg3 [2] of
     lgn_Pat_Trg : FilePath := '%1';
     lgn_Pat_Win : FilePath := MajusculeLigne (WinDir);
     lgn_Pat_Sys : FilePath := MajusculeLigne (SysDir);
    end;
   end
   else
    FilePath := MajusculeLigne (Lg3);
   IconName := Lg4;
  end;
 end
 else
  Tmp := False;
 Traitement_Icone := Tmp;
end;

(* analyse d'une ligne de fichier *)
function Traitement_Fichier (Ligne : string;Numero : integer) : boolean;
var Tmp : boolean;
    Lg1 : string;
    Lg2 : string;
    Lg3 : string;
    Num : integer;
    Err : integer;
begin
 Tmp := true;
 Delete (Ligne,1,pos (lgn_EqualSi,Ligne));
 Lg1 := Coupe (Ligne);
 Lg2 := Coupe (Ligne);
 Lg3 := Ligne;
 Val (Lg1,Num,Err);
 if Numero > Max_Files then
  Tmp := false
 else
 begin
  if not ((Lg1 = '') or (Lg2 = '') or (lg3 = '')) then
  begin
   With VFiles [Numero] do
   begin
    DiskNumb := Num;
    FileName := MajusculeLigne (Lg2);
    if Lg3 [1] = lgn_Pat_Red then
    begin
     case Lg3 [2] of
      lgn_Pat_Trg : FilePath := '%1';
      lgn_Pat_Win : FilePath := MajusculeLigne (WinDir);
      lgn_Pat_Sys : FilePath := MajusculeLigne (SysDir);
     end;
    end
    else
     FilePath := MajusculeLigne (Lg3);
   end;
  end
  else
   Tmp := False;
 end;
 Traitement_Fichier := Tmp;
end;

(* analyse d'une ligne de lancement *)
function Traitement_Run (Ligne : string;Numero : integer) : boolean;
var Tmp : boolean;
    Lg1 : string;
    Lg2 : string;
    Lg3 : string;
    Lg4 : string;
begin
 Tmp := true;
 Delete (Ligne,1,pos (lgn_EqualSi,Ligne));
 Lg1 := Coupe (Ligne);
 Lg2 := Coupe (Ligne);
 Lg3 := Coupe (Ligne);
 Lg4 := Ligne;
 if Numero > Max_Run then
  Tmp := false
 else
 begin
  if not ((Lg1 = '') or (lg2 = '') or (lg3 = '') or (lg4 = '')) then
  begin
   With VRun [Numero] do
   begin
    FileName := MajusculeLigne (Lg1);
    if Lg2 [1] = lgn_Pat_Red then
    begin
     case Lg2 [2] of
      lgn_Pat_Trg : FilePath := '%1';
      lgn_Pat_Win : FilePath := MajusculeLigne (WinDir);
      lgn_Pat_Sys : FilePath := MajusculeLigne (SysDir);
     end;
    end
    else
     FilePath := MajusculeLigne (Lg2);
    DocsName := MajusculeLigne (Lg3);
    if Lg4 [1] = lgn_Pat_Red then
    begin
     case Lg4 [2] of
      lgn_Pat_Trg : DocsPath := '%1';
      lgn_Pat_Win : DocsPath := MajusculeLigne (WinDir);
      lgn_Pat_Sys : DocsPath := MajusculeLigne (SysDir);
     end;
    end
    else
     DocsPath := MajusculeLigne (Lg4);
   end;
  end
  else
   Tmp := false;
 end;
 Traitement_Run := Tmp;
end;

(* initialisation des variables *)
procedure Initialise;
var Bcl : integer;
begin
 for Bcl := 1 to Max_Group do
 begin
  With VGroup [Bcl] do
  begin
   GroupName := '';
   GroupFile := '';
  end;
 end;
 for Bcl := 1 to Max_Icons do
 begin
  With VIcons [Bcl] do
  begin
   DiskNumb := 0;
   FileName := '';
   FilePath := '';
   IconName := '';
  end;
 end;
 for Bcl := 1 to Max_Files do
 begin
  With VFiles [Bcl] do
  begin
   DiskNumb := 0;
   FileName := '';
   FilePath := '';
  end;
 end;
 for Bcl := 1 to Max_Run do
 begin
  With VRun [Bcl] do
  begin
   FileName := '';
   FilePath := '';
   DocsName := '';
   DocsPath := '';
  end;
 end;
 for Bcl := 1 to Max_Path do
 begin
  With VPath [Bcl] do
  begin
   LettDriv := 'C';
   PathDriv := '';
  end;
 end;
end;

(**********************)
(* lecture du fichier *)
(**********************)
function ReadInsFile : integer;
var Tmp : integer;
    Fch : System.Text;
    Lgn : string;
    LTm : string;
    Bcl : integer;
    Nbr : integer;
    Lop : integer;
    Err : integer;
    Nb1 : integer;
    Par : integer;      (* 1=Inf  2=Dsk  3=Org  4=Trg *)
                        (* 5=Grp  6=Ico  7=Fil  8=Run *)
begin
 Tmp := 0;
 Par := 0;
 Initialise;
 if ExistFile (Fch_Ins) = 0 then
  Tmp := 1
 else
 begin
  assign (Fch,Fch_Ins);
  {$I-}; reset (Fch); {$I+};
  if ioresult <> 0 then
   Tmp := 2
  else
  begin
   while not (eof (Fch)) do
   begin
    {$I-}; readln (fch,Lgn); {$I+};
    if ioresult <> 0 then
     Tmp := 3
    else
    begin
     if (lgn <> '') and (Lgn [1] <> lgn_Remarks) then
     begin
      if Lgn [1] = lgn_Paragrf then
      (* calculer le nouveau paragraphe *)
      begin
       Par := 0;
       Ltm := MajusculeLigne (copy (Lgn,2,length (Lgn) - 2));
       for Bcl := 1 to Number_Para do
        if Ltm = Title_Parag [Bcl] then Par := Bcl;
       if Par = 0 then
        Tmp := 4;
      end
      else
      (* ligne a traiter *)
      begin
       if pos (lgn_EqualSi,lgn) = 0 then
        Tmp := 5
       else
       begin
        Ltm := MajusculeLigne (copy (Lgn,1,pos (Lgn_EqualSi,Lgn) - 1));
        Delete (lgn,1,pos (lgn_EqualSi,Lgn));
        case Par of
         1 : (* information *)
             begin
              if Ltm = 'TITLE' then Title := Lgn
              else
               if Ltm = 'SUBTITLE' then SubTitle := Lgn
              else
               if Ltm = 'VERSION' then Version  := Lgn
              else
               if Ltm = 'AUTHOR' then Author := Lgn
              else
               if Ltm = 'COPYRIGHT' then Copyright := Lgn
              else
               Tmp := 7;
             end;
         2 : (* disks       *)
             begin
              if Ltm = 'DSK' then
              begin
               if Traitement_NombreDsk (Lgn) = false then
                Tmp := 21;
              end
              else
               Tmp := 8;
             end;
         3 : (* origin      *)
             begin
              if Ltm = 'ODSK' then Traitement_Disque (Lgn,1)
              else
               if Ltm = 'OPAT' then Traitement_Chemin (Lgn,1)
              else
               Tmp := 9;
             end;
         4 : (* destination *)
             begin
              if Ltm = 'DDSK' then Traitement_Disque (Lgn,2)
              else
               if Ltm = 'DPAT' then Traitement_Chemin (Lgn,2)
              else
               Tmp := 10;
             end;
         5 : (* group       *)
             begin
              if Ltm = 'NUM' then
              begin
               val (Lgn,Nbr,Err);
               if (Nbr = 0) or (Err <> 0) then
                Tmp := 15
               else
               begin
                Number_group := Nbr;
                for Lop := 1 to Nbr do
                begin
                 {$I-}; readln (Fch,Lgn); {$I+};
                 if ioresult <> 0 then
                  Tmp := 3
                 else
                 begin
                  val (copy (Lgn,1,pos (lgn_EqualSi,Lgn) - 1),Nb1,Err);
                  if Nb1 <> Lop then
                   Tmp := 16
                  else
                   if Traitement_Groupe (Lgn,Nb1) = false then
                    Tmp := 17;
                 end;
                end;
               end;
              end
              else
               Tmp := 11;
             end;
         6 : (* icons       *)
             begin
              if Ltm = 'NUM' then
              begin
               val (Lgn,Nbr,Err);
               if (Nbr = 0) or (Err <> 0) then
                Tmp := 15
               else
               begin
                Number_Icons := Nbr;
                for Lop := 1 to Nbr do
                begin
                 {$I-}; readln (Fch,Lgn); {$I+};
                 if ioresult <> 0 then
                  Tmp := 3
                 else
                 begin
                  val (copy (Lgn,1,pos (lgn_EqualSi,Lgn) - 1),Nb1,Err);
                  if Nb1 <> Lop then
                   Tmp := 16
                  else
                   if Traitement_Icone (Lgn,Nb1) = false then
                    Tmp := 18;
                 end;
                end;
               end;
              end
              else
               Tmp := 12;
             end;
         7 : (* files       *)
             begin
              if Ltm = 'NUM' then
              begin
               val (Lgn,Nbr,Err);
               if (Nbr = 0) or (Err <> 0) then
                Tmp := 15
               else
               begin
                Number_Files := Nbr;
                for Lop := 1 to Nbr do
                begin
                 {$I-}; readln (Fch,Lgn); {$I+};
                 if ioresult <> 0 then
                  Tmp := 3
                 else
                 begin
                  val (copy (Lgn,1,pos (lgn_EqualSi,Lgn) - 1),Nb1,Err);
                  if Nb1 <> Lop then
                   Tmp := 16
                  else
                   if Traitement_Fichier (Lgn,Nb1) = false then
                    Tmp := 19;
                 end;
                end;
               end;
              end
              else
               Tmp := 13;
             end;
         8 : (* run         *)
             begin
              if Ltm = 'NUM' then
              begin
               val (Lgn,Nbr,Err);
               if (Nbr = 0) or (Err <> 0) then
                Tmp := 15
               else
               begin
                Number_Run := Nbr;
                for Lop := 1 to Nbr do
                begin
                 {$I-}; readln (Fch,Lgn); {$I+};
                 if ioresult <> 0 then
                  Tmp := 3
                 else
                 begin
                  val (copy (Lgn,1,pos (lgn_EqualSi,Lgn) - 1),Nb1,Err);
                  if Nb1 <> Lop then
                   Tmp := 16
                  else
                   if Traitement_Run (Lgn,Nb1) = false then
                    Tmp := 20;
                 end;
                end;
               end;
              end
              else
               Tmp := 14;
             end;
        else
         Tmp := 6;
        end;
       end;
      end;
     end;
    end;
   end;
   Close (Fch);
  end;
 end;
 ReadInsFile := Tmp;
end;

(* lecture fichier de deinstallation *)
function ReadUnsFile : integer;
var Tmp : integer;
    Fch : System.Text;
    Lgn : string;
    Num : integer;
    Err : integer;
    Oth : string;
    Ite : integer;
begin
 Tmp := 0;
 For Ite := 1 to Max_Unin do
 begin
  with VUnins [Ite] do
  begin
   TypeCase := -1;
   FullName := '';
  end;
 end;
 assign (Fch,Fch_UnIns + 'INS');
 {$I-}; Reset (Fch); {$I+};
 if IoResult <> 0 then
 (* file doesn't exist *)
  Tmp := 1
 else
 begin
  Ite := 0;
  while not (eof (Fch)) do
  begin
   {$I-}; Readln (Fch,Lgn); {$I+};
   if ioresult <> 0 then
   (* unable to read *)
    Tmp := 2
   else
   begin
    (* takes number *)
    val (copy (Lgn,1,pos (',',lgn) - 1),Num,Err);
    if Err <> 0 then
    (* not a number *)
     Tmp := 3
    else
    begin
     if Ite > Max_Unin then
     (* out of range *)
      Tmp := 4
     else
     begin
      (* assign names of files etc ... *)
      case Num of
       0,1,2 : (* Correct type *)
               begin
                Inc (Ite);
                VUnins [Ite].TypeCase := Num;
                VUnins [Ite].FullName := copy (Lgn,pos (',',Lgn) + 1,
                                               length (Lgn) - Pos (',',Lgn) + 1);
               end;
      else
      (* wrong number *)
       Tmp := 5;
      end;
     end;
    end;
   end;
  end;
 end;
 ReadUnsFile := Tmp;
end;

end.